home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / numbers.swg / 0055_Word Permutes 2!.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-25  |  3.7 KB  |  150 lines
  1. {
  2. DC>I have a little major problem... And offcourse I want YOU to help me!
  3. DC>I want to write something that gives of a 8-letter word all the possible
  4. DC>combinations. So that 'RDEPTRAO' gives 'PREDATOR'. I think it must be about
  5. DC>256 combinations. I don't need a program that gives 'PREDATOR' directly, but
  6. DC>just something that gives me all those possibilities.
  7.  
  8. Here is something that may help you a little. It works fine on my
  9. PC with one small proviso. If you specify permutations of 8
  10. objects taken 8 at a time (what you want ...) then the program
  11. runs out of heap space. Try it will smaller numbers first - like
  12. permutations of 5 objects taken 3 at a time. This will show you
  13. how it works. You can then try to modify it so that it will not
  14. run out of memory generating the 40320 permutations that you are
  15. looking for.
  16.  
  17.   Program perms, written by Clive Moses. This program will
  18.   generate all permutations of n objects, taken r at a time,
  19.   memory allowing.
  20.  
  21.   Challenge: try to modify the program so that it will not
  22.   guzzle massive amounts of memory generating its output.
  23. }
  24.  
  25. program perms;
  26.  
  27. { Program to generate permutations of n objects, taken m at a time.
  28.   For test purposes: m <= n <= 8. The program, as implemented here,
  29.   effectively uses a 'breadth-first' algorithm. If it could be changed
  30.   to run in a 'depth-first' fashion, it would not be necessary to
  31.   store all of the intermediate information used to create the
  32.   permutations. A 'depth-first' algorithm might have to be recursive
  33.   however.
  34. }
  35.  
  36. uses  crt;
  37.  
  38. type  str8   = string[8];
  39.  
  40.       torec   = ^rec;
  41.  
  42.       rec  = record
  43.         perm,
  44.         left  : str8;
  45.         next  : torec;
  46.       end;
  47.  
  48. const objects : str8 = 'abcdefgh';
  49.  
  50. var   m, n    : integer;
  51.       first   : torec;
  52.  
  53. procedure NewRec (var p : torec);
  54. begin
  55.   NEW (p);
  56.   with p^ do
  57.   begin
  58.     perm := '';
  59.     left := '';
  60.     next := NIL;
  61.   end;
  62. end;
  63.  
  64. procedure PrintPerms (var first : torec);
  65. var p     : torec;
  66.     count : integer;
  67. begin
  68.   p := first;
  69.   count := 0;
  70.   while p<>NIL do
  71.   begin
  72.     if p^.perm <> ''
  73.     then
  74.        begin
  75.          write (p^.perm:8);
  76.          inc (count);
  77.        end;
  78.     p := p^.next;
  79.   end;
  80.   writeln;
  81.   writeln;
  82.   writeln (count,' records printed.');
  83. end;
  84.  
  85. procedure MakePerms (m, n : integer; var first : torec);
  86. var i,
  87.     level : integer;
  88.     p,
  89.     p2,
  90.     temp  : torec;
  91. begin
  92.   writeln ('Permutations of ',n,' objects taken ',m,' at a time ...');
  93.   writeln;
  94.   if m <= n
  95.   then
  96.      begin
  97.        level := 0;
  98.        NewRec (first);
  99.        first^.left := copy (objects, 1, n);
  100.        while level < m do
  101.        begin
  102.          p2 := NIL;
  103.          temp := NIL;
  104.          p := first;
  105.          NewRec (p2);
  106.          while p <> NIL do
  107.          begin
  108.            for i := 1 to length(p^.left) do
  109.            begin
  110.              if temp=NIL then temp := p2;
  111.              p2^.perm := p^.perm + p^.left[i];
  112.              p2^.left := p^.left;
  113.              delete (p2^.left, i, 1);
  114.              NewRec (p2^.next);
  115.              p2 := p2^.next;
  116.            end;
  117.            p := p^.next;
  118.          end;
  119.          inc (level);
  120.          p := first;
  121.          while p<>NIL do
  122.          begin
  123.            p2 := p^.next;
  124.            dispose (p);
  125.            p := p2;
  126.          end;
  127.          first := temp;
  128.        end
  129.      end;
  130. end;
  131.  
  132. begin { Main Program }
  133.   clrscr;
  134.   first := NIL;
  135.   writeln ('Memory available = ',memavail);
  136.   writeln;
  137.   repeat
  138.     write ('Total number of objects: ');
  139.     readln (n);
  140.   until n in [1..8];
  141.   repeat
  142.     write ('Size of permutation:   ');
  143.     readln (m);
  144.   until m in [1..n];
  145.   MakePerms (m, n, first);
  146.   PrintPerms (first);
  147.   writeln;
  148.   writeln ('Memory available = ',memavail);
  149. end.
  150.